perm filename FILLER.F4[CMS,LCS]2 blob sn#103186 filedate 1974-05-24 generic text, type T, neo UTF8
00100	C  Q AND R  ARE X,Y COORDS.  NE(1)=WDCNT. OTHER NE'S HAVE 3
00200	C   FOR INVIS. VECTORS.   M=VERTICAL SCAN LINES
00300		SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
00400		DIMENSION Q(1),R(1),NE(1)
00500		KK=NE(1)
00600		NX=-10000
00700		JN=NX
00800		KJ=2
00900		DO 4 K=2,KK
01000		IF(NE(K).NE.3)GO TO 11
01100		NE(K)=KJ
01200		KJ=K+1
01300		GO TO 4
01400	11	NE(K)=0
01500	4	CONTINUE
01600		DO 12 K=1,KK
01700		Q(K)=IFIX(Q(K))
01800	12	R(K)=IFIX(R(K))
01900		NE(KK+1)=KJ
02000	C  FINDS JUMPS
02100		DO 2 J=2,KK
02200		IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02300	C  SKIPS VERTICAL LINES
02400		XMID=HALF(Q,J)+.00001
02500	C  MIDPOINT OF LINE
02600		ALT=HALF(R,J)
02700	C  THE ALTITUDE
02800		KJ=0
02900	
03000	100	DO 3 L=2,KK
03100		IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03200	C  NEXT FINDS LINE OVERLAP
03300		IF(MISS(L,XMID,Q))GO TO 3
03400	C  NEXT FINDS ALT. OF CROSSING
03500	40	Y=HGHT(L,XMID,Q,R)
03600		IF(Y.LT.ALT)KJ=KJ+1
03700	3	CONTINUE
03800	
03900		IF(MOD(KJ,2).EQ.0)GO TO 2
04000	C  NEXT IF FOUND A LINE TO DRAW LINES DOWN FROM.
04100		NE(J)=-1
04200		KJ=M
04300		N=Q(J)
04400		L=Q(J-1)
04500	CC	IF(IABS(N-L).LE.M)GO TO 2
04600	C  SKIPS SEGS SHORTER THAN M INCREMENT.
04700		ALT=.0001
04800		IF(N.GT.L)GO TO 33
04900		KJ=-KJ
05000		ALT=-ALT
05100	33	IF(L.EQ.NX.AND.JN.EQ.J-1)GO TO 17
05200		JA=3
05300		X=-1
05400	17	NX=N
05500		JN=J
05600		K=IABS(MOD(L,KJ))
05700		IF(L.LE.0.OR.KJ.LE.0)GO TO 221
05800		L=L+KJ-K
05900		GO TO 222
06000	221	IF(.NOT.L.OR.KJ.LE.0)GO TO 220
06100		L=L+K
06200		GO TO 222
06300	220	IF(.NOT.L.OR..NOT.KJ)GO TO 219
06400		L=L+KJ+K
06500		GO TO 222
06600	219	IF(.NOT.KJ.OR.L.LE.0)GO TO 222
06700		L=L-K
06800	222	IF(L.GT.N.AND.KJ.GT.0)GO TO 2
06900		IF(L.LT.N.AND.KJ)GO TO 2
07000		DO 6 K=L,N,KJ
07100		RK=K
07200		XK=RK
07300		IF(K.EQ.N)ALT=-ALT
07400	C  NO SHIFT AT LAST POSITION
07500	 	RK=RK+ALT
07600		Y=HGHT(J,RK,Q,R)
07700		IF(X)CALL LINES(XK,Y,JA,LP,IT,LS,LD)
07800		JA=2
07900		H=-10000
08000	
08100	18	DO 7 I=2,KK
08200		IF(NE(I).NE.0)GO TO 7
08300	C  SKIP IF SAME LINE.
08400		IF(MISS(I,RK,Q))GO TO 7
08500	C  TRY NEXT POINT IF IT HIT A -1 LINE.
08600	9	B=HGHT(I,RK,Q,R)
08700		IF(B.GT.Y)GO TO 7
08800		IF(B.LE.H)GO TO 7
08900		H=B
09000		IX=I
09100	C  FOUND HIGHEST NEW POINT
09200	7	CONTINUE
09300		IF(H.EQ.Y)GO TO 31
09400	C  WIPES OUT THIS LINE SEG.
09500		IF(H.NE.-10000)GO TO 31
09600		NX=-10000
09700	C***	X=1
09800		X=-1
09900		GO TO 6
10000	31	IF(IX.NE.JX.AND.X.GT.0)JA=3
10100		JX=IX
10200		CALL LINES(XK,H,JA,LP,IT,LS,LD)
10300		JA=2
10400		IF(X.GT.0)CALL LINES(XK,Y,JA,LP,IT,LS,LD)
10500		X=-X
10600	6	CONTINUE
10700	2	CONTINUE
10800		RETURN
10900		END
11000		
11100		FUNCTION HGHT(J,A,Q,R)
11200		DIMENSION Q(1),R(1)
11300		B=R(J-1)
11400		D=Q(J-1)
11500		F=Q(J)
11600		HGHT=((R(J)-B)*(A-D))/(F-D)+B
11700		IF(F.EQ.D)HGHT=B
11800		END
11900	
12000		FUNCTION MISS(J,A,Q)
12100		DIMENSION Q(1)
12200		B=Q(J)
12300		C=Q(J-1)
12400		MISS=-1
12500		IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
12600		END
12700	C  MISS=-1, HIT=0
12800	
12900		FUNCTION HALF(A,J)
13000		DIMENSION A(1)
13100		HALF=(A(J-1)-A(J))/2.+A(J)
13200		END
13300	
13400		SUBROUTINE LINES(A,B,J,I,IT,L,LD)
13500		M=A
13600		N=B
13700		IF(IT.LT.11)GO TO 41
13800		M=B
13900		N=A
14000		IF(L.AND.N.NE.LY)J=3
14100	11	IF(.NOT.I)GO TO 2
14200		IF(J.EQ.3)GO TO 1
14300		CALL AVECT(M,N)
14400		RETURN
14500	1	CALL AIVECT(M,N)
14600		RETURN
14700	41	IF(L.AND.M.NE.LX)J=3
14800		GO TO 11
14900	2	IF(J.EQ.3.OR..NOT.LD)GO TO 42
15000		NI=2
15100		IF(IT.GT.10)GO TO 44
15200		MI=IT*1.3
15300		IF(LY.LT.N)GO TO 46
15400		MI=-MI
15500		NI=-NI
15600	46	MD=MI
15700		IF(J.EQ.4)J=2
15800		IF(J.EQ.2)MD=NI
15900		LY=LY+MD
16000		IF(MI.AND.LY.LT.N)GO TO 42
16100		IF(.NOT.MI.AND.LY.GT.N)GO TO 42
16200	47	CALL PLOT(LX,LY,J)
16300		J=J+1
16400		IF(IT.GT.10)GO TO 43
16500		GO TO 46
16600	44	MI=(IT-10)*1.3
16700		IF(LX.LT.M)GO TO 43
16800		MI=-MI
16900		NI=-NI
17000	43	MD=MI
17100		IF(J.EQ.4)J=2
17200		IF(J.EQ.2)MD=NI
17300		LX=LX+MD
17400		IF(MI.AND.LX.LT.M)GO TO 42
17500		IF(.NOT.MI.AND.LX.GT.M)GO TO 42
17600		GO TO 47
17700	42	CALL PLOT(M,N,J)
17800		LX=M
17900		LY=N
18000		END